Cobra Utilities for Doom & Doom II/Cobra Utilities For Doom & Doom II - Disc 2.iso/files/program/dhtk100/sounder2.pas

Pascal/Delphi Source File | 1994-05-26 | 4.2 KB | 251 lines

unit Sounder2;

  {$C FIXED PRELOAD PERMANENT}
  {$M 65520,64500,655350}
interface

uses WadDecl;

var    SbIOAddr,SbIRQ:word;
        DMA_Complete:boolean;

Function InitSB:boolean;
Procedure SetSbIOAddr(NewAddr:word);
Procedure SetSbIRQ(NewIRQ:word);
Procedure SetVoice(State:integer);
Procedure PlayBuff(sBuff:PSoundBuff;BuffAddr:longint);
Procedure StopBuff;
Function Sys_InitSB:Boolean;
Procedure Sys_DoneSB;

Implementation

uses DOS,CRT;

CONST    DMA            =0;       {DMA Constants}
        CH0_BASE     =0;
        CH0_COUNT     =1;
        CH1_BASE     =2;
        CH1_COUNT     =3;
        CH2_BASE     =4;
        CH2_COUNT     =5;
        CH3_BASE     =6;
        CH3_COUNT     =7;
        DMA_STATUS  =8;
        DMA_CMD        =8;
        DMA_REQUEST =9;
        DMA_MASK        =10;
        DMA_MODE        =11;
        DMA_FF        =12;
        DMA_TMP        =13;
        DMA_CLEAR    =13;
        DMA_CLRMSK    =14;
        DMA_WRMSK    =15;
        DMAPAGE        =$80;

        DSP_WRITE_STATUS    =$C;        {Sound Blaster Constants}
        DSP_WRITE_DATA        =$C;

PROCEDURE cli;
INLINE
  (
  $FA    {CLI}
  );

PROCEDURE sti;
INLINE
  (
  $FB    {STI}
  );

{$F+}


var    IRQVect:pointer;
        OldExit:Pointer;

Function InitSB:boolean;

    var RetVal:Boolean;

    begin
        asm
             mov al,1
             mov dx,sbIOaddr
             add dx,6
             out dx,al
             in    al,dx
             in    al,dx
             in    al,dx
             in    al,dx
             mov al,0
             out dx,al
             add dx,4
             mov cx,100
        @@1:
             in al,dx
             cmp al,0AAh
             je @@2
             loop @@1
             mov  RetVal,False
             jmp @@3
        @@2:
             mov RetVal,True
        @@3:
        end;
        InitSb:=RetVal;
    end;

Procedure SetSbIOAddr(NewAddr:word);

    begin
        SbIOAddr:=NewAddr;
    end;

Procedure writeDAC(v:byte);

    var b:byte;

    begin
        repeat
            b:=port[sbIOAddr+DSP_WRITE_STATUS];
        until (b and $80)=0;
        port[sbIOAddr+DSP_WRITE_DATA]:=v;
    end;

Procedure SetVoice(State:Integer);

    begin
        case State of
            1:writeDAC($D1);    {Voice On}
            0:writeDAC($D3);    {Voice Off}
        end;
    end;

Procedure SetSampleRate(Rate:word);

    var    tc:byte;

    begin
        tc:=(256 - (1000000 div rate));
        writeDAC($40);
        writeDAC(tc);
    end;

Procedure SetPICStatus;

    var im,tm:byte;

    begin
        im:=port[$21];
        tm:=(1 shl sbIRQ) xor $FF;
        port[$21]:=(im and tm);
        sti;
    end;

Procedure SetDMAStatus(BuffAddr:longint;DataLen:word);

    var    t:word;

    begin
        {Set DMA Mode}
        port[DMA_MASK]:=5;
        port[DMA_FF]:=0;
        port[DMA_MODE]:=$49;
        {Set Transfer Address}
        t:=(BuffAddr shr 16);
      port[DMAPAGE+3]:=t;
      t:=(BuffAddr and $FFFF);
        port[CH1_BASE]:=(t and $FF);
      port[CH1_BASE]:=(t shr 8);
      {Set Transfer Length Byte Count}
      port[CH1_COUNT]:=(DataLen and $FF);
      port[CH1_COUNT]:=(DataLen shr 8) and $FF;
      {Unmask DMA Channel}
      port[DMA_MASK]:=1;
   end;

Procedure SetDACStatus(DataLen:word);

    begin
      {Set Up Sound Blaster for transfer}
      writeDAC($48);        {Setup DAC for DMA Transfer}
      writeDAC(DataLen and $FF);
      writeDAC((DataLen shr 8) and $FF);
      writeDAC($14);
      writeDAC(DataLen and $FF);
      writeDAC((DataLen shr 8) and $FF);
    end;

{$F+,S-,W-}
procedure IRQProc(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);

    interrupt;
   begin
       STI;
      DMA_Complete:=True;
      port[$20]:=$20;
   end;
{$F-,S+}

Procedure SetSbIRQ(NewIRQ:word);

    begin
       SbIRQ:=NewIRQ;
   end;

Function Sys_InitSB:boolean;

    var    Regs:Registers;

    begin
      if InitSB=False then begin
         writeln('Sb_Init: Failed to initialize Sound Blaster.');
           Halt(1);
      end;
      CLI;
      GetIntVec($08+sbIRQ,IRQVect);
      SetIntVec($08+sbIRQ,@IRQProc);
      STI;
      DMA_Complete:=False;
      Sys_InitSB:=True;
      SetVoice(1);
    end;

Procedure Sys_DoneSB;

    begin
      SetIntVec($08+sbIRQ,IRQVect);
      ExitProc:=OldExit;
      SetVoice(0);
   end;

Procedure PlayBuff(sBuff:PSoundBuff;BuffAddr:longint);

    type TBuff=Array[0..46080] of byte;

    begin
       DMA_complete:=False;
      InitSB;
      SetSampleRate(sBuff^.SampleRate);
      SetPICStatus;
        SetDMAStatus(BuffAddr,sBuff^.Samples);
      SetDACStatus(sBuff^.Samples);
      SetVoice(1);
   end;

Procedure StopBuff;

    begin
       SetVoice(0);
   end;

begin
    sbIOAddr:=$220;
   sbIRQ:=5;
   DMA_Complete:=False;
   Sys_InitSb;
   OldExit:=ExitProc;
   ExitProc:=@Sys_DoneSB;
end.